SC2.F4[2,LCS]1 - www.SailDart.org

perm filename SC2.F4[2,LCS]1 blob sn#305829 filedate 1977-09-22 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE READIT
C00023 00003	101	N=INP(ML)
C00042 00004	1106	KTMP=1
C00049 ENDMK
C⊗;
	SUBROUTINE READIT
	COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,TPALN(4),JED  /NAMES/NA(100),LETRS(27),JNAM(27)
CC	1 LN,ITYP,TPALN(4),JED   /IFI/IFI
CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
	COMMON/VV/LIMIT, V(1) /A/ ROFF(27),NP(27),PCH(27,32),
	1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
	1 ,P1(27),JFM(4),COPY(30),IFM(80)
	1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	DIMENSION IV(1),LIST(78),JNP(80),KNP(15)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
	COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (VX1,VX(1)),(KNP,JNP,INP1,INP(1)),(IPP,ISCA(2))
	1 ,(ISS,ISCA(9)),(ITT,ISCA(11))
	1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
	1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
	1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8))
C   *************** READS INPUT  ***********************
	KIMIT=LIMIT-100
C  FOR WARNING ABOUT BUFFER OVERLOAD (LABEL 1774)
	ICHD=0
2308	IF(ITYP)GO TO 2127
	DATA TINST /25H(' TYPE INST NAME, ETC'/)/,KSLA/'/'/
	1,TEDIT/20H(' RETYPE LINE?'/  )/,IEN/'N'/,ITMPO/'TEMPO'/
23081	TYPE TINST
	ACCEPT 77732,JNP
77732	FORMAT(80A1)
CC	IF(JED)WRITE(21,77732)INP
	IF(JED)CALL COLTTY(JNP,21)
	JFM(4)='80A1)'
C  PUTS ON LPT AND TTY
	GO TO 1074
CC 6/74 COLGATE2127	JREAD=1
CC 6/74 COLGATE 4400	READ(1,77732,END=2337)JNP
2127	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
CC  SEE END OF PG.6	IF(SOS)WRITE(JOUT,87732)INP
CC 7/74	IF(SOS)CALL COLTTY(JNP,JOUT,3)
CC 6/74  COLGATE 	GO TO(441,442,443,444,445,446)JREAD

441	JFM(4)='80A1)'
CC	IF(IFI.GE.0)GO TO 1074
	IF(LN.EQ.0)GO TO 1074
CC	REREAD 2114,LN,JNP
C****  READS FILES WITH OR WITHOUT LINE NUMBERS!
	JFM(1)=' (I,A'
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,LN,J,JNP
	GO TO 4127
1074	JFM(1)='   (A'
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,J,JNP
4127	IF(JED)GO TO 41271
	IF(K.EQ.'Y')GO TO 41271
C  K CHECK IS TO PASS AFTER RETYPING
	TYPE TEDIT
	ACCEPT 77732,K
	IF(K.EQ.'Y')GO TO 23081
	IF(K.EQ.IG)JED=-1


41271	IF(J.EQ.IBLA)GO TO 2308
	LLETRS=MLX
C  LETRS FOR NAME CHANGE FEATURE AT 104
	MLX=1
	IZ=0
	JA=-1
	ISUB=4
	CALL CLEAN(INP,LEND)
C  CLEANS OUT = AND , AND FINDS LINE LENGTH.
	ALL=1.
	VX1=0
	VX2=0
	VX3=0
	LK=-1
	K=0
	IF(V(I-1).NE.-9900.-BY)GO TO 364
	BY=-1.
	I=I-1
364	DO 361 JD=1,LEND
	N=INP(JD)
	IF(N.NE.'R')GO TO 361
C  LOOKS FOR 'RESTART'
	DO 3611 M=JD,LEND
	KL=INP(M)
	IF(KL.EQ.IBLA)GO TO 3631
	IF(KL.EQ.ISEMI)GO TO 3631
CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
3611	INP(M)=IBLA
C   CHANGES 'RESTART' TO BLANKS
3631	DO 363 N=1,NINS
	IF(J.NE.INST(N))GO TO 363
	IQ(N)=-1
C   SETS RESTART FLAG.  THIS INST WILL NOW APPEAR WITH NEW NUM.
	GO TO 362
363	CONTINUE
361	IF(N.EQ.ISEMI)GO TO 6773
6773	K=K+1
	IF(K.GT.NINS)GO TO 36
	IF(INST(K).NE.J)GO TO 6773
	IF(IQ(K).EQ.-1)GO TO 6773
C   FINDS CORRECT INST NUM.  PASSES RESTI
JR⊗"α&:N%→84(Lb-v,hP&≡=¬"=↓E;9L4)≠0&&→DQ:⊗Er:JV9Z9&≡=¬"=↓EK84(&L1"):t)9≡J,q≥&≡zαR=↓K84)EK8&∞εdaαJVtJP4)K8&&→DQ:⊗Er:&:N-⊃≥&≡zαR=↓≠I\4(LJ→")t*E9≡¬∩⊗∞∃:J≡=α$y↓Me8h(&&2B)::*q≡⊗∩M!≥&≡zαR=↓∪I\4)≠I\&&≥*	uYα4)IK8&&→DJNV	t:Q9QL:=αRz↓E]]_h(&&2B):⊗
r&R6∧y&≡=¬"=↓E;9L4(LJ→")t*E9≡≤z:∩U:J≡=α$y↓E];_4(&L1"):-	9≡Bd
e≥&<yαR=β	]]LhP&&→DQ:⊗Er:N⊗∞$I≥&≡zαR=↓↓aD4T→)))RQ)))RQ)))RQ)))ααε
>4)αε:"α
⊗2⎇9α~>∩↓≡N⊗≥"&>:~84(&L1"):-	9≡⊗t!≥&≡zαR=↓↓aH4PJ&→"Rr⊗E9<*:⊃α~9&≡=¬"=↓EβAH4(LJ→")t*E9≡4J:&M:J≡=α$y↓EAC⊂4)M3⊂&2-lr&:M[λ4(&L1"2-t:Q:.UI&∞εdaα⊗J∩B29$hP&&:≥!"2-Kj(4(Lb⊗RJ~B2-%lb2⊗R∃_4*
ααNεZ*α">]∧jε:e∧b⊗RR-∩Mα&rα&:N"qα:εl)↓"~⎇⊃↓≡J,r&Q≥Hh(&&Sj2,4PJ≡=α$y↓E];_4(4T→)))RQ)))RQ)α∩⎇:9αRz↓aAA
α~>Iα:N⊗∞$J>:M8h)EAC_&Y"JIu5eJp4(&\auD4PJ≡=α$y↓MAC_4*
ααJ⊗ε%→↓≡Bd
eαN,~Q9αs	29I8h)EACλ&Y"JIu5EKI84(LZ1uPhQMAa_J∩=↓∪↓aEα[j.11;⊂4*
RQ)))R↓α>IβAAαzurzzzury↓⎇{y⎇|4PJ&→"LrA"-Jr⊗E:L∩2¬&<yαR=β⊃AaDhP&&YDI-E%lJ:A"ZH4(&Kj%-HhQMAaλJ
euk	84(L:=αRz↓IMA@h)IACλ&∞>u"&:V(h*
↓ααJ⊗ε%→αN⊗≥"&>9∧J∩⊗:$J~&⊗∩a↓5EKI9α6
∩.Mα∀*≡&:tJ:≤4T→EAa⊂J&→"2B%5EJr⊗E9kIeAArj
e&Kj%5DhR
))RQ)))RQα~⊗∩↓EU1;λ4)EβAH&YDI%u5∪Ie84PJ%v%[λ4(&<yαR=β→AaDhR
↓↓∧jεJ.~α⊗:⊃∧z→αN,~R&>ph*
)RQ)))RQ)))RQ)))RQ)))RQ(4(hQaAAλJ~>Jl
Q"¬*aV→$hQEA\L2>J6
!"%2)1V→Hh)P&L1"2-tb∃::LrM&≡zαR=↓C9]L4PJ&→"b1:≡"qA&≡zαR=↓↓AP4PJ&→"L"ε21t:Q9AL:=αRz↓a]]_h(&
:B2-%m2aD4PJ&∩εdav2,hP&≡=¬"=↓Iβ↓P4*~↓≡6>4)≥α∞D
:≡⊗~α&9↓<
2&:~9α∞εr:Qα
*αJ⊗N-!α&9∧J:∩&2qα&:≥"M84S	AAPL∩≥"2ZIvZaλh(&&2B2-:-	:&iM2aEuh*
↓αα6εeβ→1]EαQ)))∧
21α∧
Jε6~α↑&2bα
∃α≤*QαVααεQα$J6∃↓αp4*
α↓α∞",~-α⊗42⊗∞Q∧z9↓≡lzZ∃≥λh*
↓RQ)))RQ)αε¬⊃9IMb↓Ee]
↓α~&D*Mα
:αR&6-→α&9α:6>Z*9⎇⎇⎇{y¬¬¬
	¬∧4S⊃AAPLr&:Mlb,4(LJ→"ZC→::∃s↓&Za∪iEAAβ↓9.ZC_4(&L1"Za∩r⊗E9αJZaIjiD4(L"VI"dY%vZC⊂4(&<yαR=βIA@4T→)))RQ)))∧

>Z*α~>I¬∩⊗NQ∧z:2e∧*:RJL*M9↓∧2⊗	↓A1]DhQa]]_J&→"5AI::*qA&ZC	vZa
QEAAβ↓9.ZC⊂4)eβ&&→E2aE:t):
eL:=αRz↓Qe\hP&&→DQ::∃r:B2εJ9&≡=¬"=↓U;9L4*~Q)))RQ)))RQ↓≡Bd
e≥αM→α~>∩↓≡N⊗≥"&>:~84)QK8&
em2aD4T→↓α
Kj∞VJ∀*:Qα∀9αR&l)84(M1"%%jieeAαq6
dhP&%vJYD4(LJ→":=Q::∃s↓&∞εdaα
≡≤zJQ"∃I$4)+9]L&L1"):-	:&Rmα=&≡zαR=↓	AX4PJ&→"Rr⊗E9<~>:∩*9&≡=¬"=↓Mβ	`4(LJ→")t*E9≡∧bεe≥L:=αRz↓EAa_h*
)RQ)))RQ)))∧

>Z*α~>Iα:N⊗∞$J>:M8h(4(hQQ]]_J:]veαεH4T~jjjURjh&lbav6`h(&6cj62`hP&&→DI:2QtZ&6&"J≡=α$y↓]] h(&RMα∃↓Eβ92$4PJ&→"Jr≡∃:dJ6&QM"fB∃β	]]PhQE]] J~>Jl
Q!=:↓)))RQ))α$z=α6,~!α&uαVQα$
R¬¬
↓↓αV≤)↓
6MBN∞I∩↓)))RQ))≥zH4)]; &ε2ciE84PJ∩→uh(&&≥*	uDhR∞bb@J&→"lba:2"r2⊗:"J≡=α$y↓E];→H4*≥Bbaα$B&MαdzNQα|q↓%nπA↓9↓r↓9↓mααRε.,qα>V"↓a=Iαy]X4T~bb`L:=αRz↓]]]_h(4*≥RjjjURjjjURjjjURjjjURjjhhQEIeHJ&→"lba:2*r2⊗:"J≡=α$y↓E];_4*∞URjjjURjjjURjjiαr2Q9¬RjjjURjjjURh4(hP4)];9L&&2BJ⊗ε$*I"*u↓%&∞b1αJ,r&P4T→↓αJ,
∩Mα
α2&:*q↓α&2α⊗:⊃∧z→α~Lb∃1αU*6BMph(&&2B&:A
r⊗E:L∩2¬&<yαR=β9]]LhP&&→DR⊗⊃&<yαR=β9]]M_h(&RMα∃αR,"&P4PJε∞∞-αQ↓];9MI2Xh(&&2B-::*q≡e≥L:=αRz↓QQHhP&Rf∧)αRBb84(L
∞∞⊗¬!↓]];→I2*u4)Q#⊂&&→DY:⊗EtJ≥&*,!u5DhR
↓↓∧">⊗Nr:Qα↑⎇∩-α~⎇⊃α⊗∩M"Mαεt!α&:≤*JRM¬J⊗Q⎇{x4(4Ph)]];→L&6eAuD4T→↓α~⎇⊃α∞>u"&:V
"&>9∧b&:⊗~q"∞εr:Q↓≡≤z:R&u*∃≥α%:&∞∃∧J9α¬¬∩>]¬
H4*
α↓↓≡2M~RM≥∧jVNQ∧*:⊃α<JR!↓Zα&9αt*]!]{9Q%α4*JN&|q94PJ∞ε2bα∞2⊗q"&:αb2⊗:"H4)E;9L&&2B&BJrr⊗E9αJ≡=α$y↓E];→H4(Lav%5λh(&&2BFRMt:∃9AL:=αRz↓Ue\hP&&→E1"%5
I:⊗EsIee9Lav15λh)Ue8J&BJsj&BJriD4(LJ→"B
∩⊗:Mt*E9AL:=αRz↓E]]≠_4(&∧
J⊗:≠i@4(Lb&NQDb∞:Q[⊃%v0hP&2∞u!v2∞u!-L4PJ&→"MαJ9:-	9A&<yαR=β	]]M⊂h(&&¬∩9u@hQE]]≠_&2&≥!"6>"Iv04PJ6>Qk4*
α↓α~>∩α⊗JJ⎇⊃αRJ
4(4T~
E];→H&*Si@4)9]MHLqu@4S	]]MλJ61vlb`4(hR
↓↓∧∩&≥αdz>A↓jiαR=∧*:⊃α|1αBε<)↓E8hP&*⊃lj04)K9T&9lJ:A"T!$4(LJ→"9t*E:&∀b¬&≡zαR=↓∪→X4*≤~jjhLJ→"9t*E:&∀b¬:>∩r9:⊗
q≥1≥L:=αRz↓IMXhR
↓!BA!!%JI%%αl
e↓E~a]E↓⎇Q↓"⊃"z∃>aβ⊃↓M%zα∞M=∧*R
9αα∞ε9¬*N∃↓∪1α2ε∀*2M8hQMMYλ&&→Dq:⊗Er9!≥&<yαR=β1e\4PJ&→"rr:∃9:I≥&≡zαR=↓∪→YD4S1e\&LrA"*"Iv&
dλ4(&cj*⊃5λh)UE_&&→DJ:A"bI::∃tJ
2¬L:=αRz↓IEE_h(&1la5D4PJ≡=α$y↓UE_4)I	L&&2B9:⊗
q≥%≥L:=αRz↓MMYλh(&&2BBεJ,rM:⊗
qA&≡zαR=↓	Q@4PJ2∞:#j2∞:"YL4(LJ→"6⎇!::∃s↓&∞εdaα⊗J∩AM$4PJ6>Qlb∞:Qkλ4)E!@&∩z↓EEQβ	α*
k	22∞u!5E1_h(&&2B&:ADa%::*r2&N"B*
%L:=αRz↓EEQβλ4*
αα~&:%→α∩V∧b&∞ε$)α&∩,rR&~L*H4(M"fB∃β	EQA∩b&:ADa$4(L~ε21∧*b&PhP4)E!AH&4zJ6ε"A≥α6⎇"&Z&~↓!≥2	1≥%¬*N⊗⊃¬"↑&∞*9$4)	QADL~>:RLrV∀4PJ2&N"B2∞:"Iv&:αB1$4PJBεJ,rMu5
p4(&LrA"1Kj&
2λh(&2M~Q"2≤rQ-EKj$4(L:=αRz↓IMXhR
↓≥:9≥≥≥:α~>I¬~&:≡d)αFV⎇"⊗L4S→MYDLJBJ9lJBJ9[λ4(&<yαR=β⊃MX4T→↓α*,jBMα∀
∞-αLrR=α
*>R∃¬~⊗∞RLz84*≥λ&&→EαεJ⊗u→:⊗Es↓&≡=¬"=↓I!@4*≥λ&2&≥!"2∞u!-I%l`4*∞λJ2∞:#j2∞:"YL4*≥λ&Bε∀*:Muh*∞DL:=αRz↓MMY⊂4*∞⊃EQ@Lb&NQDj>Q%l`4*∞λJ≡=α$y↓MM3	H4*≥

↓%JI%%%JI%%%αα2εN"↓%α∞q≡Qα
αB⊗ε∩αεQα,r⊃α>2α2&:*	∧4*~αααα∧αααα∧αα↓↓|αi>∩≠→=α⊗$→94S⊃MYDLJ→"9tr∃9≥R9&≡=¬"=↓I≠1H4(LJ∞"⊃lJ∞"⊃[λ4(&sj.N2λh(&≡zαR=↓≠→X4)∪→YH&L1"9:t)9≡↓:J≡=α$y↓UM3λ4(&$y↓EE~α1uEdb⊗:⊂hP&-vT!.04T→↓↓αZα&Mα-~⊗⊃α
!↓IQα	¬∧4PJ*≥vLrA"-Hh(&&2B*≥:t)9≥5:J≡=α$y↓YE_4(&∀*RJ=k4(&LrA"-Kj&
2λh(&≡zαR=↓	L4)3	EL&L1"*≥tr∃9≥"9&≡=¬"=↓]	L4*~↓↓≥⊃:α&Mα4zIα&u2⊗JNLz:MαLq↓≡:⎇"⊗M≤hP&&:5∩Qu@hP&≡=¬"=↓E_4)]	L&&2B*≥:t):&
d	&≡=¬"=↓Q	L4)	L&∞|rR&:,(4)Q	L&∩z↓YMY
α*6>#iE22≤rQ1LhP&&→DR≥::*r2&N"B*6>"I&≡=¬"=↓Y≠1D4(M2aEuh(&∩z↓QAαkj*⊃-∩b2⊗: h(&*;j&:ADi$4(LJ→"*:r⊗E:L∩2¬&<yαR=β!@4*≤~jjhLJ→"*:r⊗E:]~2¬:⎇⊃:*≥t*E:&≤*6%:⎇⊃:*≥t*E9≥R9&≡=¬"=↓E#4(&L1"*≥t*E:.≤b¬&≡zαR=↓!@4(LJ→"*:r⊗E:M~⊗6%L:=αRz↓EQ@hP&61lh4(&<yαR=β⊃Q@4S!@&∞|rR&:,(4)I#&*
lR∧4(LR¬u5λh(&&u↓"-%lJ
2∧hP&∞εdaαN∞rH4(LR¬v*_h)EQJ*
uλh(&.sj2&N"B*6>"YE$4PJ5v2M~Q"*lzQ-IJYD4(LJ→"J-"J=&<yαR=β1Q@4PJ*
vjiD4(Liv.9kλ4(&\qv*hP&*
jiD4(M∩⊗RJ{i5E8hQYQ@LJ→"&u2JQ&<yαR=βIQ@4SAQ@&CjY".rH4(&∀⊃v`4PJavε∃→"a%]2aD4PJiv`hP&&→E∩	&ijjh4(M1"%%mP4*∞_JY"%Kja.ZCλ4*
αα~&:%→α∞⊗u"⊗Iα4zIα&u2⊗JNLz9↓!]"Jε:≥↓9$4PJ%v%[λ4(&\qv.9\R4(LJ→"YDZ96*~I::∃sAU9&<yαR=βIQ@4PJY"%k	%ua*p4(&<yαR=βAQ@4Ph)eQJivYDZ9$4PJ&→"LrZJQt*E9AL:=αRz↓QQ@hP&&→E2aE:-	9A&<yαR=β)Q@4T→↓↓	∧αEα9α⊃↓α↑D*J∃αsi↓E=∩αNR⊗¬→α&9α::>R-→≥α>∩α6V2"α~ε∞$zIα&rα>R"-∩M84PJ&→"≤z∩∃:-	95M~q&≡=¬"=↓Q#4(&2B%%vRRZaDhP&≡=¬"=↓]≠1D4)#!@&&2Bi:⊗
qaU9L:=αRz↓UQ@hP&euh(&J∪jZaDhP&&→EQ&J	jjJλ4PJ&→"LrZJQL:=αRz↓UQDhP&J	jjJλ4PJJ
v@h(&&2Bi&J≠i6JhR
αRDJMαN%*~→α4zIα∞DzJ⊃α4*εRV∀(4(&Ki"J
mQ%)HhQUQDM1"%%mQ.J	]H4*∞_J&→"LrZJQt*E9AMIu"amQ%)Iph*∞M1"%%mQ.Za
Zd4(L:=αRz↓]MYλh)UQJY"%Kjh4);→YD&L1"*
t:Q9AL:=αRz↓UQLhP&&→D~>∩∃tr∃95≠→&≡=¬"=↓U#_4(&T9v$4PJ&→"2B%%:=!9A&<yαR=β)QL4S)QH&KjY"*
	V(JG)=V(JG-1)
	V(JG-1)=Y
C THIS STUFF FOR CHORD FEATURE
	IF(V(JG-2).GT.0)GO TO 543
	JG=JG-1
	GO TO 542
543	I=I+1
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	INVRT=-1
	RB=V(I-1)
	DO 8361 L=JD,LEND
	JG=INP(L)
C   PUT IN NOV 25, 72
CCZZZ	IF(JG.EQ.ISEMI)GO TO 93612
	KN=L
	INP(L)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.')')IPRN=IPRN+1
	IF(JG.NE.ISEMI)GO TO 8361
	IAMP=-1
	GO TO 9361
8361	CONTINUE
C  ABOVE 4 LINES PUT IN 8/76. REPLACE C***********  ↓↓

9361	MLX=L+1
	IF(L.GE.LEND)GO TO 93612
C************9361	MLX=L
C************	IF(L.EQ.LEND)GO TO 93612
C ↑↑↑↑↑↑↑ 6/75
C  FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
	IF(IAMP.NE.0)GO TO 797
	IF(QTS)GO TO 1773
C  GO BACK IF NOT END OF LINE
797	JZ=-1
93612	IF(IAMP.EQ.0)GO TO 93611
C   NOV 25, 72
	IF(QTS)GO TO 3013
	GO TO 2722
C  THESE ARE FOR "LIT" ITEMS
C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
C  NO $ WITH FUNC.  $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
CCZZZ93611	IF(JG.EQ.ISEMI)GO TO 7773
93611	IF(KN.EQ.LEND)GO TO 7773
	JZ=0
	IF(IPRN.NE.0)GO TO 1773
C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
	GO TO 236
C  LAST TIME FOR QUOTES

C********↑↑ ↑↑ WAS TO 6017  JUNE 10,71
C   JUMPS TO END STRING OF QUOTES
6361	CONTINUE
	CALL ERR(LN)
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361	IF(N.EQ.'$')CALL ERR(LN)
C  FOUND $  BUT NO @!
	IF(N.NE.ID)GO TO 53611
	IF(ISUB.NE.1)GO TO 53611
	IF(INP(JD+1).NE.IF)GO TO 236
C  JUMP IF NOT DUTY FACTOR
	DF=DF-100.
	GO TO 43615
53611	IF(N.NE.ISS)GO TO 53612
	IF(INP(JD+1).NE.'U')GO TO 53612
	DF=DF-200
C  FOR SUBROUTINE FLAG.  CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
	GO TO 43615
53612	IF(N.NE.IAA)GO TO 43611
C   FINDS 'ALL'.
	IF(INP(JD+1).NE.'L')GO TO 236
	ALL=-1.
	GO TO 43615
C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.

C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
C   BEFORE! QUAD (IF USED).
C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
43611	IF(N.NE.'Q')GO TO 4361
	IF(INP(JD+1).NE.'U')GO TO 4361
	QX=-13.
	DO 43612 N=JD,LEND
	J=INP(N)
	IF(J.EQ.IXX)QX=QX-1.
	IF(J.EQ.IF)QX=QX-2.
	IF(J.EQ.IBLA)GO TO 236
	IF(J.EQ.KSLA)GO TO 236
CCZZZ	IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
43612	INP(N)=IBLA
4361	IF(N.NE.'I')GO TO 43613
	IF(ISUB.NE.4)GO TO 43613
C  -1= 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
C  -2= 'NM IE' MAKES 'END' OF PRINTOUT INVIS. ( ;PRINT(P1)--ETC.)
C  THIS IS SO PARAMS MAY BE EXTENDED TO 58 ON TO A DUMMY INST.
	L=-1
	N=INP(JD+1)
	IF(N.EQ.IE)L=L-1
	INVIS(LK)=L
43615	DO 43614 L=JD,LEND
	N=INP(L)
CC	IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
	IF(N.EQ.IBLA)GO TO 236
	IF(N.EQ.ISEMI)GO TO 236
CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
43614	INP(L)=IBLA
CC43613	IF(N.NE.KSLA)GO TO 636
43613	IF(N.NE.KSLA)GO TO 1336
CC	JZ=-1
	IF(JD.GE.LEND-1)JZ=0
C  SO IT WILL READ NEXT LINE.
CZZZZZZZZZZZZZZZ	INP(JD)=ISEMI
	GO TO 336
CCZZZ436	IF(INP(MLX).NE.IBLA)GO TO 336
CCZZZ	MLX=MLX+1
CCZZZ	GO TO 436
CC636	IF(JD.LT.LEND)GO TO 1336
CC	ICON=0
CC	GO TO 77731
CC	GO TO 7773
C  TO CONTINUE ON NEXT LINE.
CCZZZ636	IF(N.NE.ISEMI)GO TO 936
1336	IF(N.NE.ISEMI)GO TO 936
	IAMP=-1
CC	IF(ISUB.NE.1)IAMP=-1
336	MLX=JD+1
	IF(ISUB.GE.104)GO TO 104
	IF(ISUB.GT.3)GO TO 1899
   	GO TO (101,102,103),ISUB
C             PAR  MOV LIST  OTHERS
CCZZZ936	IF(N.NE.IDOT)GO TO 736
936	IF(N.NE.IDOT)GO TO 136
	L=INP(JD+1)
	DO 836 KL=1,10
836	IF(L.EQ.IDAT(KL))GO TO 236
	IF(CODE.EQ.-22.)INP(JD)=1
	GO TO 236
C   CHANGES DOTTED RHYTHMS TO '1'S.
CCZZZ736	IF(N.NE.'*')GO TO 136
CCZZZ	IAMP=-1
CCZZZ	INP(JD)=IBLA
CCZZZ	GO TO 336
136	IF(N.NE.IQT)GO TO 236
	DO 1361 K=JD+1,LEND
	IF(INP(K).NE.IQT)GO TO 1361
	JD=K+1
	GO TO 975
C   SKIPS MATERIAL IN QUOTES
1361	CONTINUE
	CALL ERR(LN)
C   OPEN QUOTES
236	JD=JD+1
	IF(JD.LE.LEND)GO TO 975
	CALL ERR(1)
1899	CALL SCANR
CZZZZZZZ	ML=MLX
CZZZZZZZZZZZZZZZZZZZZZZZZZZ
	GO TO(1,2,3,4,5,6),ISUB
101	N=INP(ML)
	IZ=ML
	ML=ML+1
	IF(N.EQ.IBLA)GO TO 101
C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
	JA=-1
	IF(N.EQ.IPP)GO TO 1
	IF(N.EQ.IE)GO TO 2308
	IF(N.EQ.'R')CALL RUNIT
C   'RUN' MAY REPLACE 'END' FOR LAST INST.
	IF(N.EQ.ID)GO TO 7720
	CALL ERR(LN)
1	CALL SCANR
 	LPAR=VX1
	IJ=LPAR
	IF(QX.GE.0)GO TO 5703
	IJ=LPAR+4
C  SETS UP PARAM FOR QUAD CALL
	V(I)=IJ+LK*10000
	V(I+1)=2*ALL
C  TEST "ALL" FEATURE HERE!!!!!!!
C  X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
	V(I+2)=QX
	I=I+3
	QX=0.
5703	IAMP=0
	IF(IJ.LE.NP(LK))GO TO 897
	IF(IJ.LT.31)NP(LK)=IJ
897	IF(LPAR.EQ.32)LPAR=1
	V(I)=LPAR+LK*10000
C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
	IJ=I+1
	I=I+4
	ITMP=0
	CODE=0
	NFLG=1
	ML=IZ+M
C   RE=REP  R=RHY  L=LIT  M=MOVE  MX=MOVX  N=NOTES  NU=NUM  
C   S--L=SUBL  S--N=SUBN  T=TAP  RT=RTAP  RL=RLIST  RN=RNOTES
C  QU=QUADC  QUX=QUADX 
5702	ML=ML+1
CC	IF(ML.GT.72)GO TO 99
	N=INP(ML)
	IF(N.EQ.IBLA)GO TO 5702
	IF(N.EQ.',')GO TO 5702
	NL=INP(ML+1)
	JA=-1
	ISUB=0
	IF(N.EQ.IXX)GO TO 2703
	IF(N.EQ.'R')GO TO 6702
	IF(N.EQ.IF)GO TO 8702
	IF(N.EQ.IPP)GO TO 7006
	IF(N.NE.'C')GO TO 4005
	IF(NL.EQ.'U')GO TO 7006
C  FOR 'CUTOFF'
4005	JA=0
	IF(N.EQ.IEN)GO TO 6005
	IF(N.EQ.'M')GO TO 703
	IF(N.EQ.'L')GO TO 2720
	IF(N.EQ.ISS)GO TO 6703
	IF(N.EQ.ITT)GO TO 4018
	IF(N.EQ.IQT)GO TO 5720
	IF(N.EQ.ISEMI)GO TO 2018
C 7/75	IF(N.EQ.IPP)JA=-1
C  FOR ;P5  P3;
7006	CALL SCANR
	IF(ISUB.EQ.8)GO TO 8
	I=I+JJ
	V(IJ+1)=NNUM+DF
	IF(JJ.EQ.1)GO TO 4006
C  IF NNUM IS '-2' THEN NOTES ARE PRINTED
	IF(NNUM.NE.-2)GO TO 5006
	IX=IJ+3
	DO 2006 K=2,JJ,3
2006  CALL RANR(VX,K)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
5006	IX=IJ+2
	DO 6006 K=1,JJ
6006	V(IX+K)=VX(K)
	IF(NL.EQ.'U')GO TO 8006
	V(IX+JJ-2)=1.
C  ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
	GO TO 3013
4006	IF(JA)VX1=-VX1/100.-9999.
C  CHANGES ;P5 P3; TO ;P5 -9999.03; ***** CHECK OUT ON OTHER MACHINES!
CIRC4006	IF(JA)VX1=VX1/100.+9999.
CIRC  CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
	V(I-1)=VX1
	GO TO 3013
8006	V(IJ+1)=-19
C  FOR 'CUTOFF N1, N2' -- TO END RAND TIMES TOGETHER.
	GO TO 3013
6702	IF(NL.EQ.IE)GO TO 2703
C   JUMP IF "REP"
	IF(NL.EQ.ITT)GO TO 4018
C   JUMP IF "RTAP"
	CODE=-22
	IF(NL.EQ.'L')CODE=-46.0
C   JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
	IF(NL.NE.IEN)GO TO 1016
C   JUMP IF NOT "RNOTES"
	JA=0
C   FOR SCANR
	CODE=-36.
	GO TO 1016
6005	CODE=-33
	IF(NL.EQ.'A')GO TO 2721
C  NUMS, NOTES, NAMES.
	IF(NL.NE.'U')GO TO 1016
	CODE=-44.
1610	JA=-1
	GO TO 1016
8702	CODE=-35
	IF(NL.EQ.'U')GO TO 1016
	ML=ML+1
	CALL SCANR
7	V(IJ+1)=CODE+DF
	V(IJ+2)=1.
	IF(VX1.GT.15)CALL ERR(4) 
C TRAPS F NUMS >15.
	V(I)=VX1+85.
	GO TO 7703
C********  MOVE IS NEXT ***********
703	BW=V(IJ-2)
	IC=0
CC	DO 7031 K=ML+1,72
	DO 7031 K=ML+1,LEND
	LP=INP(K)
	IF(LP.EQ.KSLA)GO TO 8031
CC	IF(INP(K).EQ.ISEMI)GO TO 8031
	IF(LP.EQ.IPP)IC=1
C 'MOVP' P7 MOVP/10 3,4.9 5,5.9;MOVES FROM RAN SEL. OF P3,P4 TO P5,P5.
7031	IF(LP.EQ.IXX)IC=-1
C   IC=-1 IS FOR MOVX, IC=0 FOR MOVE, IC=1 FOR MOVP.
8031	I=I-1
	V(I)=0
	X=-9900.-BY
	IF(BY.EQ.0)X=-9900.-BG(LK)
   	IF(BW.EQ.X)GO TO 8005
	IF(BW.NE.-9900.-BY)GO TO 1102
	V(IJ-2)=X
	GO TO 8005
1102	V(IJ)=V(IJ-1)
	V(IJ-1)=X
	IJ=IJ+1
	I=I+1
8005	LP=IJ-1
	BW=-9900.-X
	ISUB=2
	IZ=-1
C  ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
4703	GO TO 1299
102	IF(IZ.LT.0)GO TO 2102
C  SKIPS NEXT FIRST TIME
	BW=V(ICT)+BW
	V(I)=-9900.-BW
	V(I+1)=V(LP)
	V(I+2)=(JJ+2)*ALL
	V(I+3)=CODE+DF
	I=I+4
	IZ=1
2102	IF(BW.LT.10000.)CALL BGSORT(BW)
C   ROUND-OFF NONSENSE
2	VX3=-9900.
	VX2=VX3 
	CALL SCANR
	IF(JJ.GT.0)GO TO 5102
	JJ=ILIT
C SLASH WILL REPEAT MOVE INPUT -- 6/74
	DO 6102 K=1,JJ
6102	VX(K)=VX(K+20)
	GO TO 5005
C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
5102	IF(JJ.EQ.4)CALL ERR(LN)
C  ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
	IF(VX3.NE.-9900.)GO TO 3102
	IF(VX2.NE.-9900.)GO TO 4102
	VX2=VX1
	VX1=10000.
4102	VX3=VX2
	JJ=3
C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102	IF(IZ.GE.0)GO TO 3006
	V(IJ)=(JJ+2)*ALL
C  WORD COUNT
	CODE=-55.
	IF(JJ.NE.3)CODE=-57.
	IF(NFLG)CODE=CODE-1.
	IF(IC)CODE=-59.
C  CODE=-56 OR -58 FOR NOTES.
	V(IJ+1)=CODE+DF
	IZ=0
3006	IF(NFLG.EQ.1)GO TO 5005
	CALL RANR(VX,2)
      IF(JJ.NE.3)CALL RANR(VX,4)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
5005	IF(IC.LE.0)GO TO 3003
C NEXT FOR 'MOVP',  MOVE FROM PARAM TO PARAM.
	DO 1003 K=2,JJ
1003	VX(K)=-VX(K)/100.0-9999.0
CIRC1003	VX(K)=VX(K)/100.0+9999.0
C  CHANGES PARAM NUMS TO MAGIC NUMS.
3003	ICT=I
	ILIT=JJ
C  SAVES FOR SLASH REPEAT FEATURE
  	IJ=IJ+1
	DO 1006 K=1,JJ
	VX(20+K)=VX(K)
C  SAVES FOR SLASH REPEAT FEATURE
1006	V(IJ+K)=VX(K)
	I=I+JJ  
	IJ=I+2
	IF(IAMP.EQ.0)GO TO 1299
C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
	V(I)=-9900.-BY
	GO TO 8703

7703	V(IJ)=4.*ALL
8703	I=I+1
	GO TO 4773
C   FOR SUBROUTINES, -12=NUMS.  -11=LETTERS.
6703	CODE=-12.
	IF(INP(ML+3).EQ.'L')CODE=-11.
	V(IJ)=2.*ALL
	V(IJ+1)=CODE+DF
	I=I-1
	GO TO 4773
4018	CNT(LK)=-9900.-BY
	P(LK)=V(I-4)
CC 6/74 COLGATE 	JREAD=3
CC 6/74 COLGATE	GO TO 4400
1444	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
CC443	IF(IFI)REREAD 107,K,IPT(LK,1)
CC	IF(IFI.GE.0)REREAD 8001,IPT(LK,1)
443	IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
	IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
C   NAME OF RHYTHM FILE. (ONLY ONE PER INST.)  READS DATA JUST BEFORE RUN
	IF(J.EQ.'CONDU')GO TO 444
	IF(NL.NE.ITT)GO TO 2338
	CODE=-23.
	GO  TO 1016
2338	I=I-4
	GO TO 4773
3018	CNT(KZY)=-9900.
	GO TO 1444
444	P(KZY)=980000.
	GO TO 2308
C   CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
C  'REP'
2703	ML=ML+1
	VX1=0
	VX2=0
	VX3=0
	IF(N.EQ.IXX)GO TO 2704
	INP(ML)=IBLA
	INP(ML+1)=IBLA
C  WIPES OUT 'EP' IN 'REP'
2704	CALL SCANR
 	V(IJ)=3.
	V(IJ+1)=-66.0
	IF(VX1.EQ.32.)VX1=1.
	IF(VX1.EQ.0)VX1=LPAR
	IF(VX2.EQ.0)VX2=LK-1
	V(IJ+2)=VX1+VX2*10000.
	KL=VX2
	IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
	IF(VX3.EQ.0)GO TO 4773
	L=VX3
	ML=LK+1
	DO 1018 KL=ML,L
	IF(LPAR.LE.NP(KL))GO TO 997
	IF(LPAR.LT.31)NP(KL)=LPAR
997	IF(DUR(KL))DUR(KL)=DUR(LK)
C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
	V(I)=V(I-4)+10000.
	V(I+1)=3.
	V(I+2)=-66.
	V(I+3)=V(I-1)
1018	I=I+4
	GO TO 4773

2018	IF(DF.EQ.0)GO TO 20181
C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
	V(IJ+1)=-201.
	V(IJ+2)=1.
	V(IJ+3)=0
	GO TO 7703
20181	V(IJ)=3.
	V(IJ+1)=-66.
	V(IJ+2)=NW+LK*10000
	GO TO 4773
C  READS /P5  .3 "ABC" .7 "XYZ"/

8 	V(IJ+1)=-77.+DF
C  DF HAS SUBR CALL INFO
	I=I+1
	VX(JJ-1)=1
C  FOR RAND. SINGLE LITS.
	DO 3722 K=1,JJ,2
	V(I)=VX(K)
3722	I=I+1
	V(IJ+2)=JJ/2
	V(IJ+3)=I
	DO 4722 K=2,JJ,2
	KN=I
	I=I+1
	L=VX(K)
	DO 6722 KL=L,LEND
	IF(INP(KL).EQ.IQT)GO TO 4722
	IV(I)=INP(KL)
6722	I=I+1
4722	V(KN)=I-KN-1
	V(IJ)=(I-IJ)*ALL
	GO TO 4773
2720	QTS=0
2721	ISUB=104
	IF(NL.EQ.'A')ISUB=ISUB+1
	GO TO 1299

104	IF(ISUB.EQ.104)GO TO 1041
C NEXT FOR INST NAME CHANGES.  Pn NAMES/N;
C  V LIST= n000n/WDCNT/-89/NUM OF DUPLS/INST NAME/NUM OF LETTERS IN NAME/
C  *********** NO 'ALL' OR 'DUPL' FEATURES WITH NAMES **************
	V(IJ)=5
	V(IJ+1)=-89
	CALL SCANR
	V(I-1)=VX1
	IV(I)=INST(LK)
CXX	IV(I+1)=2**(1+(7-LETRS)*7)
	I=I+2
	GO TO 4773
1041	KL=0
	DO 6721 K=ML,LEND
	L=INP(K)
	IF(L.EQ.IBLA)GO TO 6721
	JC=K+1
	IF(L.EQ.IQT)GO TO 7721
	IF(L.EQ.KSLA)GO TO 7232
	IF(L.EQ.ISEMI)GO TO 7232
	IF(L.NE.IF)GO TO 1040
	IF(INP(K+1).NE.'I')GO TO 1040
	IF(INP(K+2).NE.IEN)GO TO 1040
	IF(INP(K+3).NE.IE)GO TO 1040
C FINDS THE WORD "FINE".
	V(I)=-10000.
	IF(DUR(LK))DUR(LK)=1000
	GO TO 1042
1040	IF(L.EQ.'%')INP(K)=KSLA
	IF(L.EQ.'?')INP(K)=ISEMI
	IF(L.EQ.'!')INP(K)=','
	IF(L.EQ.'#')INP(K)='<'
	IF(L.EQ.'&')INP(K)='"'
C  THE ABOVE ARE ALL SPECIAL CHAR'S TO AVOID VARIOUS CONFUSIONS.
	IF(KL.EQ.0)KL=K
6721	CONTINUE
C  FOR REPEAT OF ITEM BY SLASH
C  KL IS START OF QUOTE, THEN K IS END -- WHEN NO "S ARE USED.
7232	IF(KL.EQ.0)GO TO 7233
	JC=KL
	ML=K+1
	JD=K-1
	NLIT=K-KL
	GO TO 8721

7233	DO 7230 KL=ILIT,ILIT+NLIT
	V(I)=V(KL)
7230	I=I+1
	GO TO 27222
7231	CONTINUE

5720	IAMP=-1
	JC=ML+1
C  FOR SINGLE 'LIT' ITEMS.
7721	DO 1722 KL=JC+1,LEND
	IF(INP(KL).NE.IQT)GO TO 1722
	JD=KL-1
	ML=KL+1
	NLIT=KL-JC
C   EXTENT OF LIT ITEM IS FOUND
	GO TO 8721
1722	CONTINUE
C  CAN'T USE SLASH FOR REPEAT AFTER @Q
8721	V(I)=NLIT
	ILIT=I
	DO 9721 K=JC,JD
C   PUTS ITEM IN "IV" ARRAY
	I=I+1
9721	IV(I)=INP(K)
	I=I+1
27222	IF(IAMP.EQ.0)GO TO 1299
2722	V(I)=999.
1042	QTS=-1.
	X=-88.
CNEW	IF(ISUB.EQ.105)X=-89.
C 105, -89. FOR LIST OF NAMES FOR INST. NAME CHNGS.
27221	V(IJ+1)=X+DF
	V(IJ)=(I-IJ+1)*ALL
	IJ=IJ+2
	V(IJ)=IJ+1
	I=I+1
	ISUB=1
	GO TO 1299

7720	V(I)=LK
	V(I+1)=3.
	V(I+2)=-67.
	ML=ML+4
	CALL SCANR
 	V(I+3)=VX1
	I=I+4
	L=VX1
	IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
	IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
	GO TO 4773
C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.
142	FORMAT(I,15A5) 
1301	FORMAT(15A5) 
1302	FORMAT(1X15A5) 
CCC2773	FORMAT(I,A5,72A1) 
CC2114  FORMAT(I,80A1)
300	FORMAT(I,3F,A1)
301	FORMAT(3F,A1)
6	IF(J.NE.'PRECE')GO TO 1341
C  'PRECEDE' WRITES LINES DIRECTLY ON DSK, BEFORE THE WORD 'PLAY;'.
C  NO LIMIT TO THE NUMBER OF LINES.  LAST LINE (NOT PRINTED) MUST 
C  BEGIN WITH *.     KNP ARRAY (15) IS EQUIV. TO INP .
4341	IF(ITYP)GO TO 5341
	TYPE TPALN
	ACCEPT 1301,KNP
	CALL SHORT(KNP,K)
	WRITE(21,1301)(KNP(JD),JD=1,K)
	GO TO 6341
5341	IF(LN.EQ.0)GO TO 2341
CC5341	IF(IFI.GE.0)GO TO 2341
	READ(23,142)K,KNP
	GO TO 3341
2341	READ(23,1301)KNP
3341	CALL SHORT(KNP,K)
C  DON'T TYPE TRAILING BLANKS
 	IF(MX.NE.22)TYPE 1302,(KNP(JD),JD=1,K)
6341	IF(MX.EQ.22)WRITE(JOUT,1302)(KNP(JD),JD=1,K)
	IF(INP1.EQ.'*')GO TO 2308
	IF(MX)WRITE(1,1301)(KNP(JD),JD=1,K)
CC	IF(MX)WRITE(23,1301)KNP
	GO TO 4341
1341	KB=KB+1
	IF(JED.GT.0)JED=0
	IF(J.EQ.'INSER')GO TO 1340
	OTH(KB,1)=VX1*100000.+VX2*100.+VX3   
	GO TO 340   
1340	X=VX1
	IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2    
	OTH(KB,1)=X
	GO TO 1338
C   ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
C   INSTRUMENT.  FOR COMMENT AT START, SET BG TIME TO 1,1 
C   - BEGIN LINE WITH  <,END WITH ; 
C   UP TO 75 CHARACTERS MAY BE TYPED.     
340      IF(VX3.NE.2)GO TO 1338 
	IF(ITYP.GE.0)GO TO 449
CC	JREAD=5
CC 6/74  COLGATE	GO TO 4400
	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
445	OTH(KB,3)=1.
CC	IF(IFI.GE.0)GO TO 447
	IF(LN.EQ.0)GO TO 447
	REREAD 300,K,OTH(KB,2)
	GO TO 1447
447	REREAD 301,OTH(KB,2)
CIRC447	REREAD 301,OTH(KB,2)
1447	IF(JED)GO TO 2308
3445	TYPE TEDIT
	ACCEPT 77732,K
	IF(K.EQ.IG)JED=-1
	IF(J.EQ.'INSER')GO TO 3446
	IF(K.NE.'Y')GO TO 2308
	IF(JED)GO TO 2308
449	TYPE TPALN
	ACCEPT 301,OTH(KB,2)
	IF(JED)WRITE(21,301) OTH(KB,2)
	GO TO 2308

1338	IF(ITYP.GE.0)GO TO 1449
CC	JREAD=6
CC 6/74 COLGATE	GO TO 4400
	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
CC446	IF(IFI.GE.0)GO TO 448
446	IF(LN.EQ.0)GO TO 448
	REREAD 142,K,(OTH(KB,JD),JD=2,16)    
	GO TO 1446
448	REREAD 1301,(OTH(KB,JD),JD=2,16)    
1446	IF(JED)2446,3445,2446
3446	IF(K.NE.'Y')GO TO 2446
	IF(JED)GO TO 2446
1449	TYPE TPALN
	ACCEPT 1301,(OTH(KB,JD),JD=2,16)
	IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
2446	X=OTH(KB,2)
	IF(J.NE.'INSER')GO TO 971
	IF(VX3.EQ.0)GO TO 971
	IF(X.NE.'*')GO TO 6
971	IF(X.EQ.'*')KB=KB-1
C   ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
C   LAST LINE HAS '*' IN COLUMN 1.
	GO TO 2308
C   IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
C   INSERT MAY INCLUDE 10 CHARS(P3-P30),
C   P2, A # ONLY.  IF MORE THAN 1 PARAM IS TO BE EDITED AND
C   P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
C   CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
C   JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
C   BX=INST N. Y=NOTE N. Z=PARAM N. 
1106	KTMP=1
	TP=60.
	IAMP=0
	BW=BY
	ITMP=-1
	ISUB=5
	JA=-1
	GO TO 2016
3019	V(I)=990000.00
	V(I+1)=4.
	V(I+2)=VX1
	V(I+3)=VX2/TP
	V(I+4)=VX3/TP
	I=I+5
	BY=BW
C  SEPT 18, 70
	IF(VX1.EQ.0)GO TO 2308
	BW=BW+VX1
	V(I)=-9900.-BW
	I=I+1
	CALL BGSORT(BW)
9003	IF(IAMP)GO TO 4003
2016	VX3=0
	VX2=0
	GO TO 1299
5	IF(VX2.NE.0)GO TO 105
C  'TEMPO/120;'  OR  'TEMPO/1.5 72;'  IS OK.
	VX2=VX1
	VX1=0
105	IF(VX3.EQ.0)VX3=VX2
	IF(VX2.LT.11.)TP=1.
	IF(J.EQ.ITMPO)GO TO 3019
  	PCH(1,KTMP)=VX1
	PCH(2,KTMP)=VX2
	PCH(3,KTMP)=VX3
C   PCH(1)=TIME  (2)=MM1  (3)=MM2
	KTMP=KTMP+1
	IF(IAMP.EQ.0)GO TO 2016
4003	VX1=0
	IAMP=0
	VX2=VX3
	IF(J.EQ.ITMPO)GO TO 3019
	PCH(1,KTMP)=0
	PCH(2,KTMP)=VX2
	PCH(3,KTMP)=VX2
C   MM CAN BE FROM 11 UP  TEMPO FACTOR FROM 10 DOWN.  
C   UP TO 30 TEMPO CHANGES MAY BE MADE.   

1016      IA=I    
      IZ=1  
3100	V(I-2)=CODE+DF
      ISUB=3     
5016	IF(IAMP.GE.0)GO TO 1299
117	IF(IZ-2)3013,9004,9004
103	K=INP(ML)
	IF(K.EQ.ITT)GO TO 1106
	IF(K.EQ.KSLA)GO TO 1014
	IF(K.EQ.ISEMI)GO TO 1014
CZZZZZZZZZZZZ  CC  ZZZZZZZZZZZZ
	IF(K.NE.IPP)GO TO 1010
	IF(JA.GE.0)GO TO 1899
	JA=-2
	GO TO 1011
1010	IF(K.NE.IBLA) GO TO 1899
1011	ML=ML+1
	GO TO 103
3	IF(VX1.EQ.-99.)GO TO 4022
	IF(CODE.EQ.-22.)GO TO 2017
  	IF(CODE.LT.-23)GO TO 17
	IF(IZ/2*2.EQ.IZ)GO TO 17
C    CHECKS PAIRS OF NUMBERS FOR 'RTAP'
2017	IF(VX1.EQ.-10000.)GO TO 17
CIRC2017	IF(VX1.EQ.10000.)GO TO 17
      VX1=4./VX1
	IF(JJ.NE.1)GO TO 2014
	V(I)=VX1
	GO TO 114

1217	IF(VX1.EQ.-10000.)GO TO 114
CIRC1217	IF(VX1.EQ.10000.)GO TO 114
C    FOR "FINE" IN LIST
      V(I+1)=VX2
      IF(CODE.EQ.-36.)CALL RANR(V,I)
2217	I=I+1
C  SETS UP STRING OF RAND SELECTIONS
	GO TO 114
3217	V(I)=V(I-2)
	V(I+1)=RB
C  FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
	GO TO 2217
C******** PUT IN ERROR TRAP FOR "REP" ETC. ******

2014	DO 9006 L=2,JJ
	IF(VX(L).EQ.0)GO TO 17
9006	VX1=4./VX(L)+VX1
	JJ=1
17	IF(JA.NE.-2)GO TO 1012
	VX1=-9999.0-VX1/100.0
	JA=-1
1012	IF(ICHD.EQ.0)GO TO 4014
	JJ=1
C  SETS UP NEXT NOTE AS CHORD (THIS ONE BECOMES NEG.)
	VX1=-VX1
C  FOR CHORD FEATURE
	ICHD=0
4014	V(I)=VX1
	IF(CODE.EQ.-46.)GO TO 1217
	IF(CODE.EQ.-36.)GO TO 1217
	IF(CODE.NE.-35)GO TO 972
	IF(VX1.GT.15)CALL ERR(4)
C  FINDS F NUM.>15!
C  JUMP IF STRING OF RAND SELECS.
972	IF(JJ.EQ.1)GO TO 114
	L=VX(JJ)-1
	X=V(I)
	NL=I+1
	I=L+I
	DO 1017 K=NL,I
1017	V(K)=X
C   ADDS UP TOTAL   OF NOTES IN SEQ.
	IZ=IZ+L
	GO TO 114
1014	IF(CODE.EQ.-46.)GO TO 3217
	IF(CODE.EQ.-36.)GO TO 3217
	IF(CODE.NE.-33)GO TO 1103
	IF(V(I-2).GE.0)GO TO 1103
C NEXT FOR SLASH REPEAT OF CHORD
CCC	I=I-1
	JC=1
	JD=1
	GO TO 2103
1103	V(I)=RB
C   RB SAVES IT FOR SLASH REPEAT
114      RB=V(I)     
      I=I+1 
      IZ=IZ+1     
      GO TO 5016    
4022	JC=VX2+.3
	JD=VX3-.5
	IF(JJ.EQ.2)JD=1
C********* MAY 19,71   ----MANY LINES ABOVE.
2103	IZ=IZ+JC*JD 
C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
	IF(CODE.NE.-33)GO TO 3103
8103	N=0
	V(IA-1)=0
	DO 4103 K=I-1,1,-1
	IF(V(K).GE.0)N=N+1
4103	IF(N.EQ.JC)GO TO 5103
5103	IF(V(K-1).GE.0)GO TO 6103
	IF(V(K).EQ.0)GO TO 6103
	K=K-1
	GO TO 5103
6103	JC=I-K
CC	I=I+1

3103	DO 1005 K=1,JD    
	NL=I+JC-1  
	DO 2005 L=I,NL    
2005  V(L)=V(L-JC)
1005      I=I+JC  
	RB=V(NL)
C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
      GO TO 5016  

9004	IF(ITMP.EQ.0)GO TO 3013
	IZ=IZ-1
C***** JAN. 1974
      KA=1  
      IC=1  
      K=0   
	J=1
      Z=0   
      RC=0  
9007	Y=PCH(3,IC)/TP
	X=PCH(2,IC)/TP
      Z=PCH(1,IC) 
	CALL SQYY(YY,X,Y,Z)
	XT(1)=X
      PR=RA 
C75      RD=1  
C75      RB=0  
      ZZ=Z  
      CALL ACCEL
      IF(K.EQ.IZ)GO TO 3013
	IF(RA.NE.-10000.)GO TO 9007     
C********* MAY 13,71  OMITS REPEATED RHY. FEATURE.
3013	X=I-IJ
	V(IJ+2)=X-3.
	V(IJ)=X*ALL
	IF(CODE.NE.-35)GO TO 4773
	M=IJ+3
C   SETS NUMBERS FOR FUNCS.
	DO 313 K=M,I-1
313	IF(V(K).LT.85.)V(K)=V(K)+85.
	GO TO 4773

	END